home *** CD-ROM | disk | FTP | other *** search
/ Merciful 1 / Merciful - Disc 1.iso / software / f / final_writer / finalwriter4ukenglish1.dms / in.adf / FWMacros.lha / GfxClip < prev    next >
Encoding:
Text File  |  1994-09-21  |  11.1 KB  |  353 lines
  1. /* ================================    */
  2. /*  FINAL WRITER AREXX MACRO            */
  3. /*  Graphics Clip Macro Generator.    */
  4. /* $VER: GfxMacroGen 3.1 (21.9.94)    */
  5. /* ================================    */
  6. Options Results
  7.  
  8. SetMeasure MICROPOINTS
  9.  
  10. /* Get a list of all the selected objects. */
  11. i = 0
  12. FirstObject SELECTED
  13. IF ( Result = 0 ) THEN DO
  14.     ShowMessage 1 1 '"No graphic objects are selected." "The graphic clip macro will not be generated." "" "OK" "" ""'
  15.     EXIT
  16.     END
  17.  
  18. DO WHILE ( Result ~= 0 )
  19.     i = I + 1
  20.     Object.i = Result
  21.     NextObject Object.i SELECTED
  22.     END
  23.  
  24. /* Get a filename to use */
  25. RequestText '"Graphic Clip" "Enter Graphic Clip Macro filename:" ""'
  26. IF    ( RC ~= 0 ) THEN EXIT
  27.  
  28. /* Make sure a filename is entered */
  29. filename = Result
  30. IF ( LENGTH(filename) = 0 ) THEN DO
  31.     ShowMessage 1 1 '"You did not enter a filename." "The graphic clip macro will not be generated." "" "OK" "" ""'
  32.     EXIT
  33.     END
  34.  
  35. /* Does the file already exist? */
  36. IF    ( EXISTS(filename) ) THEN DO
  37.     firstLine = '"The file <' || filename || '> already exists."'
  38.     secondLine = '"Do you want to replace it?"'
  39.     ShowMessage 2 1 firstLine secondLine '"" "Yes" "No" ""'
  40.     IF ( Result = 2 ) THEN EXIT
  41.     END
  42.  
  43. /* What is the page height we are working with? */
  44. GetPageSetup HEIGHT
  45. pageHt = Result
  46.  
  47. /* Open the file. */
  48. IF ( OPEN('GfxClipFile', filename, 'Write') ) THEN DO
  49.     /* File is opened. */
  50.  
  51.     /* Write the file header stuff */
  52.     CALL LineOut('GfxClipFile', '/* ------------------------ */')
  53.     CALL LineOut('GfxClipFile', '/* Final Writer Arexx Macro */')
  54.     CALL LineOut('GfxClipFile', '/* Graphics Clip Macro      */')
  55.     CALL LineOut('GfxClipFile', '/* ------------------------ */')
  56.     CALL LineOut('GfxClipFile', '')
  57.     CALL LineOut('GfxClipFile', 'Options Results')
  58.     CALL LineOut('GfxClipFile', 'SetMeasure MICROPOINTS')
  59.     CALL LineOut('GfxClipFile', 'page = 1')
  60.     CALL LineOut('GfxClipFile', 'numobjs = 0')
  61.     CALL LineOut('GfxClipFile', 'Status SCROLLPOS')
  62.     CALL LineOut('GfxClipFile', 'PARSE VAR Result XPos YPos')
  63.     CALL LineOut('GfxClipFile', '')
  64.  
  65.  
  66.     /* -----------------------------------------------    */
  67.     /* For each object, determine the coordinates and    */
  68.     /* find the minimum x and y values to use to            */
  69.     /* normalize the coordinatess.                            */
  70.     /* -----------------------------------------------    */
  71.     x = 0
  72.     DO WHILE ( x < i )
  73.         x = x + 1
  74.  
  75.         GetObjectType Object.x
  76.         objtype.x = Result
  77.  
  78.         /* Before getting the coordinates un-rotate the object */
  79.         GetObjectRotation Object.x
  80.         objRotate.x = Result
  81.         IF ( objRotate.x ~= 0 ) THEN
  82.             SetObjectRotation Object.x 0
  83.  
  84.         /* Get the coordinates */
  85.         GetObjectCoords Object.x
  86.         PARSE VAR Result page.x x1.x y1.x x2.x y2.x
  87.  
  88.         /* If we un-rotated the object, rotate it back. */
  89.         IF    ( objRotate.x ~= 0 ) THEN
  90.             SetObjectRotation Object.x objRotate.x
  91.  
  92.         /* Convert page and y value to a value from top of first page */
  93.         y1.x = ((page.x - 1) * pageHt) + y1.x
  94.  
  95.         IF    ( x = 1 ) THEN DO
  96.             XNormalizer = x1.x
  97.             YNormalizer = y1.x
  98.             END
  99.  
  100.         IF ( x1.x < XNormalizer ) THEN
  101.             XNormalizer = x1.x
  102.         IF ( y1.x < YNormalizer ) THEN
  103.             YNormalizer = y1.x
  104.  
  105.         IF    ( objtype.x = 2 | objtype.x = 3 ) THEN DO
  106.             y2.x = ((page.x - 1) * pageHt) + y2.x
  107.  
  108.             IF ( x2.x < XNormalizer ) THEN
  109.                 XNormalizer = x2.x
  110.  
  111.             IF ( y2.x < YNormalizer ) THEN
  112.                 YNormalizer = y2.x
  113.             END
  114.         END
  115.  
  116.     /* Now normalize the coordinates */
  117.     x = 0
  118.     DO WHILE ( x < i )
  119.         x = x + 1
  120.         x1.x = x1.x - XNormalizer
  121.         y1.x = y1.x - YNormalizer
  122.         IF ( objtype.x = 2 | objtype.x = 3 ) THEN DO
  123.             x2.x = x2.x - XNormalizer
  124.             y2.x = y2.x - YNormalizer
  125.             END
  126.         END
  127.  
  128.     /* For each one of the graphic objects in our list */
  129.     /* create AREXX code to redraw the object.            */
  130.     x = 0
  131.     DO WHILE ( x < i )
  132.         x = x + 1
  133.  
  134.         SELECT
  135.             WHEN (objtype.x = 2 | objtype.x = 3) THEN DO
  136.                 /* -------------- */
  137.                 /* We have a Line */
  138.                 /* -------------- */
  139.                 modifier = ""
  140.                 if    ( objtype.x = 3 ) THEN
  141.                     modifier = 'ARROW'
  142.  
  143.                 /* Output the commands to calculate line's position. */
  144.                 commandLine = 'fromX =' x1.x '+ XPos'
  145.                 CALL LineOut('GfxClipFile', commandline)
  146.                 commandLine = 'toX =' x2.x '+ XPos'
  147.                 CALL LineOut('GfxClipFile', commandline)
  148.  
  149.                 commandLine = 'fromY =' y1.x '+ YPos'
  150.                 CALL LineOut('GfxClipFile', commandline)
  151.                 commandLine = 'toY =' y2.x '+ YPos'
  152.                 CALL LineOut('GfxClipFile', commandline)
  153.  
  154.                 /* Output the commands to draw the line. */
  155.                 commandLine = 'DrawLine page fromX fromY toX toY' modifier
  156.                 CALL LineOut('GfxClipFile', commandLine)
  157.                 CALL LineOut('GfxClipFile', 'objectid.numobjs = Result')
  158.                 CALL LineOut('GfxClipFile', 'numobjs = numobjs + 1');
  159.  
  160.                 /* Output the commands to set the line's parameters. */
  161.                 GetObjectParams Object.x TEXTFLOW FLOWDIST LINEWT
  162.                 PARSE VAR Result tf fd lw
  163.                 commandLine = 'SetObjectParams 0' 'TEXTFLOW' tf 'FLOWDIST' fd 'LINEWT' lw
  164.                 CALL LineOut('GfxClipFile', commandLine)
  165.  
  166.                 /* The line color may contain spaces, so treat it separately. */
  167.                 GetObjectParams Object.x LINECOLOR
  168.                 commandLine = 'SetObjectParams 0'  'LINECOLOR' "'" || '"' || Result || '"' || "'"
  169.                 CALL LineOut('GfxClipFile', commandLine)
  170.                 END
  171.  
  172.             WHEN (objtype.x = 4 | objtype.x = 5) THEN DO
  173.                 /* ------------- */
  174.                 /* We have a Box */
  175.                 /* ------------- */
  176.                 modifier = ""
  177.                 if (objtype.x = 5) THEN
  178.                     modifier = 'BEVEL'
  179.  
  180.                 /* Output the command to draw the box. */
  181.                 commandLine = 'newX =' x1.x '+ XPos'
  182.                 CALL LineOut('GfxClipFile', commandline)
  183.                 commandLine = 'newY =' y1.x '+ YPos'
  184.                 CALL LineOut('GfxClipFile', commandline)
  185.  
  186.                 commandLine = 'DrawBox page newX newY' x2.x y2.x modifier
  187.                 CALL LineOut('GfxClipFile', commandLine)
  188.                 CALL LineOut('GfxClipFile', 'objectid.numobjs = Result');
  189.                 CALL LineOut('GfxClipFile', 'numobjs = numobjs + 1');
  190.  
  191.                 /* Output the commands to set the box's parameters. */
  192.                 GetObjectParams Object.x TEXTFLOW FLOWDIST LINEWT FILL
  193.                 PARSE VAR Result tf fd lw fl
  194.                 commandLine = 'SetObjectParams 0' 'TEXTFLOW' tf 'FLOWDIST' fd 'LINEWT' lw 'FILL' fl
  195.                 CALL LineOut('GfxClipFile', commandLine)
  196.  
  197.                 /* The line and fill colors may contain spaces, so treat them separately. */
  198.                 GetObjectParams Object.x LINECOLOR
  199.                 commandLine = 'SetObjectParams 0'  'LINECOLOR' "'" || '"' || Result || '"' || "'"
  200.                 CALL LineOut('GfxClipFile', commandLine)
  201.  
  202.                 GetObjectParams Object.x FILLCOLOR
  203.                 commandLine = 'SetObjectParams 0'  'FILLCOLOR' "'" || '"' || Result || '"' || "'"
  204.                 CALL LineOut('GfxClipFile', commandLine)
  205.                 END
  206.  
  207.             WHEN (objtype.x = 6 | objtype.x = 9) THEN DO
  208.                 /* ------------------------- */
  209.                 /* We have an Oval or an Arc */
  210.                 /* ------------------------- */
  211.                 modifier = ""
  212.                 if (objtype.x = 9) THEN
  213.                     modifier = 'ARC'
  214.  
  215.                 /* Output the command to draw the oval. */
  216.                 commandLine = 'newX =' x1.x '+ XPos'
  217.                 CALL LineOut('GfxClipFile', commandline)
  218.                 commandLine = 'newY =' y1.x '+ YPos'
  219.                 CALL LineOut('GfxClipFile', commandline)
  220.  
  221.                 commandLine = 'DrawOval page newX newY' x2.x y2.x modifier
  222.                 CALL LineOut('GfxClipFile', commandLine)
  223.                 CALL LineOut('GfxClipFile', 'objectid.numobjs = Result');
  224.                 CALL LineOut('GfxClipFile', 'numobjs = numobjs + 1');
  225.  
  226.                 /* Output the commands to set the oval's parameters. */
  227.                 GetObjectParams Object.x TEXTFLOW FLOWDIST LINEWT FILL
  228.                 PARSE VAR Result tf fd lw fl
  229.                 commandLine = 'SetObjectParams 0' 'TEXTFLOW' tf 'FLOWDIST' fd 'LINEWT' lw 'FILL' fl
  230.                 CALL LineOut('GfxClipFile', commandLine)
  231.  
  232.                 /* The line and fill colors may contain spaces, so treat them separately. */
  233.                 GetObjectParams Object.x LINECOLOR
  234.                 commandLine = 'SetObjectParams 0' 'LINECOLOR' "'" || '"' || Result || '"' || "'"
  235.                 CALL LineOut('GfxClipFile', commandLine)
  236.  
  237.                 GetObjectParams Object.x FILLCOLOR
  238.                 commandLine = 'SetObjectParams 0' 'FILLCOLOR' "'" || '"' || Result || '"' || "'"
  239.                 CALL LineOut('GfxClipFile', commandLine)
  240.                 END
  241.  
  242.             WHEN (objtype.x = 7) THEN DO
  243.                 /* ------------------- */
  244.                 /* We have a TextBlock */
  245.                 /* ------------------- */
  246.  
  247.                 /* Output the command to draw the textblock. */
  248.                 commandLine = 'newX =' x1.x '+ XPos'
  249.                 CALL LineOut('GfxClipFile', commandline)
  250.                 commandLine = 'newY =' y1.x '+ YPos'
  251.                 CALL LineOut('GfxClipFile', commandline)
  252.  
  253.                 GetTextBlockText Object.x
  254.                 text = Result
  255.                 commandLine = 'DrawTextBlock page newX newY' '"' || text || '"'
  256.                 CALL LineOut('GfxClipFile', commandLine)
  257.                 CALL LineOut('GfxClipFile', 'objectid.numobjs = Result');
  258.                 CALL LineOut('GfxClipFile', 'numobjs = numobjs + 1');
  259.  
  260.                 /* Output the commands to set the textblock's parameters. */
  261.                 GetObjectParams Object.x TEXTFLOW FLOWDIST
  262.                 PARSE VAR Result tf fd
  263.                 commandLine = 'SetObjectParams 0' 'TEXTFLOW' tf 'FLOWDIST' fd
  264.                 CALL LineOut('GfxClipFile', commandLine)
  265.  
  266.                 /* Output the commands to set the textblock's typespecs. */
  267.                 GetObjectTypeSpecs Object.x SIZE LEADING WIDTH OBLIQUE
  268.                 PARSE VAR Result sz ld wd ob
  269.                 commandLine = 'SetObjectTypeSpecs 0' 'SIZE' sz 'LEADING' ld 'WIDTH' wd 'OBLIQUE' ob
  270.                 CALL LineOut('GfxClipFile', commandLine)
  271.  
  272.                 /* The color and font may contain spaces, so treat them separately. */
  273.                 GetObjectTypeSpecs Object.x COLOR
  274.                 commandLine = 'SetObjectTypeSpecs 0' 'COLOR' "'" || '"' || Result || '"' || "'"
  275.                 CALL LineOut('GfxClipFile', commandLine)
  276.  
  277.                 GetObjectTypeSpecs Object.x FONT
  278.                 commandLine = 'SetObjectTypeSpecs 0' 'FONT' '"' || Result || '"'
  279.                 CALL LineOut('GfxClipFile', commandLine)
  280.                 END
  281.  
  282.             OTHERWISE ITERATE        /* Ignore images (objtype.x = 1), groups (objtype.x = 8),*/
  283.                                         /* draw class objects (objtype = 10)                            */
  284.                                         /* and anything else we don't recognize.                 */
  285.             END /* End select */
  286.  
  287.         /* Output command to rotate the object if needed */
  288.         IF    ( objRotate.x ~= 0 ) THEN DO
  289.             commandLine = 'SetObjectRotation 0' objRotate.x
  290.             CALL LineOut('GfxClipFile', commandLine)
  291.             END
  292.  
  293.         /* Output the command to set the objects title. */
  294.         GetObjectTitle object.x
  295.         commandLine = 'SetObjectTitle 0' '"' || Result || '"'
  296.         CALL LineOut('GfxClipFile', commandLine)
  297.  
  298.         /* Output a blank line */
  299.         CALL LineOut('GfxClipFile', '')
  300.  
  301.         END /* End while */
  302.  
  303.     /* Output commands to select all the new objects. */
  304.     CALL LineOut('GfxClipFile', 'i = 0')
  305.     CALL LineOut('GfxClipFile', 'DO WHILE (i < numobjs)')
  306.     CALL LineOut('GfxClipFile', 'SelectObject objectid.i MULTIPLE')
  307.     CALL LineOut('GfxClipFile', 'i = i + 1')
  308.     CALL LineOut('GfxClipFile', 'END')
  309.     CALL LineOut('GfxClipFile', '')
  310.  
  311.     /* Output the command to redraw everything. */
  312.     CALL LineOut('GfxClipFile', 'Redraw')
  313.     CALL LineOUt('GfxClipFile', 'GraphicTool')
  314.     CALL LineOut('GfxClipFile', '')
  315.  
  316.     /* Close the file */
  317.     CALL CLOSE('GfxClipFile');
  318.  
  319.     /* Reselect all of our objects */
  320.     x = 0
  321.     DO WHILE ( x < i )
  322.         X = X + 1
  323.        SelectObject Object.x MULTIPLE
  324.        END
  325.  
  326.     END /* End if */
  327. ELSE DO
  328.     /* File could not be opened. */
  329.     firstLine = '"Cannot open file <' || filename || '>."'
  330.     ShowMessage 1 1 firstLine '"" "" "OK" "" ""'
  331.     EXIT
  332.     END
  333.  
  334. EXIT
  335.  
  336.  
  337. /* ============================================ */
  338. /* LineOut                                      */
  339. /* Procedure to write a line out to the file    */
  340. /* checking for errors and exiting if any found */
  341. /* ============================================ */
  342. LineOut: PROCEDURE
  343. PARSE ARG filehandle, str
  344.  
  345.     len = WRITELN( filehandle, str )
  346.     IF (len ~= LENGTH(str) + 1) THEN DO
  347.         ShowMessage 1 1 '"Error writing file!" "" "" "OK" "" ""'
  348.         CALL CLOSE(filehandle);
  349.         EXIT
  350.         END
  351.  
  352. RETURN
  353.